MacTech 1 to 12/MacTech-vol-1-12.toast/Source/MacTech® Magazine/Volume 12 - 1996/12.05 May 96/Challenge.p

Text File | 1996-03-05 | 3.9 KB | 144 lines | [TEXT/CWIE]

unit Challenge;

interface

    uses
        Types;

    type
        CharsArray = packed array[0..0] of byte;
        CharsArrayPtr = ^CharsArray;

    procedure ReverseTheWords( text: CharsArrayPtr; numCharsIn: longint );

implementation

    uses
        Memory;

{
    Author: Peter N Lewis <[e-mail]>

    This is not really optimal, I felt compelled to send in a Pascal solution since I was
    one of the people who complained about the language bias.  I didn’t have time to do
    this challenge justice.

    Method:

    Allocate a block of memory equal in size to numCharsIn (if numCharsIn < 2048, we
    short circuit this to use a block of memory on the stack).

    Initialize a 0..255 array to determine whether a character is  an alphanum (I could
    just use the ANSI ctype.p file, but without a macro call, there is a pretty big hit).

    reverse the words from the source to our new buffer.  We move in from both ends,
    copying non-alphanums, and then swapping words and fixing the case.

    BlockMoveData the buffer back to the source buffer.

    Release the memory if we allocated any.
}

    procedure ReverseTheWords( text: CharsArrayPtr; numCharsIn: longint );
        const
            stack_space_size = 2048;
        var
            space: packed array[0..stack_space_size] of byte;
            buffer: CharsArrayPtr;
            memory: Handle;
            leftin, leftout, rightin, rightout, leftedge, rightedge: longint;
            i: longint;
            leftchar, rightchar: integer;
            alphanum_set:array[0..255] of Boolean;
    begin
        { allocate memory if needed }
        if numCharsIn < stack_space_size then begin
            memory := nil;
            buffer := @space;
        end else begin
            memory := NewHandle( numCharsIn );
            if memory = nil then begin
                DebugStr( 'Memory allocation failed!' );
                exit( ReverseTheWords );
            end;
            HLock(memory);
            buffer := CharsArrayPtr( memory^ );
        end;

        { init - I wish I could do this at compile time - Turbo Pascal can }
        for i := 0 to 255 do alphanum_set[i] := false;
        for i := 48 to 57 do alphanum_set[i] := true; { 0..9 }
        for i := 65 to 90 do alphanum_set[i] := true; { A..Z }
        for i := 97 to 122 do alphanum_set[i] := true; { a..z }

        { reverse }
        leftin := 0;
        leftout := leftin;
        rightin := numCharsIn - 1;
        rightout := rightin;
        while leftin <= rightin do begin
            while not alphanum_set[text^[leftin]] & (leftin <= rightin) do begin
                buffer^[leftout] := text^[leftin];
                Inc(leftout);
                Inc(leftin);
            end;
            while not alphanum_set[text^[rightin]] & (leftin < rightin) do begin
                buffer^[rightout] := text^[rightin];
                Dec(rightout);
                Dec(rightin);
            end;
            leftedge := leftin;
            rightedge := rightin;
            while alphanum_set[text^[leftin]] & (leftin <= rightin) do begin
                Inc(leftin);
            end;
            if leftin > rightin then begin { central word, just copy, ignore case }
                for i := leftedge to leftin - 1 do begin
                    buffer^[leftout] := text^[i];
                    Inc(leftout);
                end;
            end else begin
                while alphanum_set[text^[rightin]] do begin { there is a sentinel now, we dont need to check leftin < rightin }
                    Dec(rightin);
                end;
                leftchar := text^[leftedge];
                rightchar := text^[rightin+1];
                if ( leftchar > 57 ) & ( rightchar > 57 ) then begin { both letters }
                    if leftchar > 90 then begin
                        if rightchar <= 90 then begin
                            rightchar := rightchar + $20;
                            leftchar := leftchar - $20;
                        end;
                    end else begin
                        if rightchar > 90 then begin
                            rightchar := rightchar - $20;
                            leftchar := leftchar + $20;
                        end;
                    end;
                end;
                buffer^[leftout] := rightchar;
                Inc(leftout);
                for i := rightin+2 to rightedge do begin
                    buffer^[leftout] := text^[i];
                    Inc(leftout);
                end;
                for i := leftin-1 downto leftedge+1 do begin
                    buffer^[rightout] := text^[i];
                    Dec(rightout);
                end;
                buffer^[rightout] := leftchar;
                Dec(rightout);
            end;
        end;

        { copy buffer }
        BlockMoveData( buffer, text, numCharsIn );

        { free memory if required }
        if memory <> nil then begin
            DisposeHandle( memory );
        end;
    end;

end.